home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 031-040 / amok31 / boothandler / boothandler.mod < prev    next >
Text File  |  1993-11-04  |  14KB  |  529 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.     BootHandler.mod
  3.     :Contents.      Dies ist ein Dos-Handler, der Bootblöcke als Files simuliert
  4.     :Author.      Bernd Preusing
  5.     :Address.      Gerhardstr. 16  D-2200 Elmshorn
  6.     :Phone.      04121/22486
  7.     :Copyright.      Public Domain
  8.     :Language.      Modula-2
  9.     :Translator.  M2Amiga V3.2e
  10.     :Support.      nach 'Amiga 9/89' Seite 118ff aus C übersetzt und Fehler raus.
  11.     :History.      1.0 02-Sep-89 Bernd Preusing
  12.     :Imports.      DosSupport [bne]
  13.     :Bugs.      NICHT reentrant! (hat bis jetzt noch nicht gestört)
  14.     :Bugs.      nicht SEHR getestet!
  15.     :Remark.      Benutzt sehr viel BPOINTER und BPTR!
  16.     :Remark.      Dies ist kein normales Programm, sondern ein Handler!!
  17.     :Remark.      Es muß 'l:Boot-Handler' heißen! Siehe Dokumentation!
  18.     :Usage.      'mount BOOT:' dann z.B. 'copy boot:df0 boot:dh29'
  19. ---------------------------------------------------------------------------*)
  20. MODULE BootHandler;
  21.  
  22. FROM SYSTEM    IMPORT    CAST, ADDRESS, BPTR, LONGSET, ADR, SETREG;
  23. FROM Arts    IMPORT    TermProcedure, wbStarted, startupMsg;
  24. IMPORT Exec;
  25. FROM Exec    IMPORT    MsgPortPtr, WaitPort, PutMsg, MessagePtr,
  26.             Node, NodePtr, List, ListPtr, UByte,
  27.             MemReqs, MemReqSet, Task,
  28.             IOStdReqPtr, AllocMem, FreeMem, OpenDevice, CloseDevice,
  29.             AddTail, Remove, Wait, GetMsg, DoIO, FindTask;
  30. IMPORT Dos;
  31. FROM Dos    IMPORT    readWrite, oldFile, newFile, beginning, current,
  32.             end, sharedLock, exclusiveLock, BSTR, FileHandlePtr,
  33.             FileLockPtr, DosLibraryPtr, DosPacketPtr,
  34.             objectInUse, actionNotKnown, deviceNotMounted,
  35.             invalidLock, FileLock,
  36.             freeLock, locateObject, examineObject,
  37.             seekError, deleteProtected, read, write, currentVolume,
  38.             flush, deleteObject, objectNotFound, writeProtected,
  39.             ProcessPtr, DosPacket, DeviceListType, DeviceListPtr,
  40.             FileSysStartupMsgPtr, EnvironmentPtr, sizeBlock,
  41.             reservedBlocks, memBufType, lowCyl,
  42.             blksPerTrack, numHeads,
  43.             FileInfoBlock, FileInfoBlockPtr, ProtectionFlags,
  44.             ProtectionFlagSet;
  45. FROM ExecSupport IMPORT NewList, CreatePort, DeletePort, CreateStdIO,
  46.             DeleteStdIO;
  47. FROM DosSupport     IMPORT    BSTRtoStr;
  48.  
  49. CONST
  50.     FNSIZE = 128;
  51.     ACTIONEND = 1007;
  52.     ACTIONSEEK = 1008;
  53.     DOSTRUE = -1;
  54.     DOSFALSE = 0;
  55.  
  56. TYPE
  57.     CharPtr = POINTER TO CHAR;
  58.     UnitData = RECORD
  59.             node: Node;
  60.             port: MsgPortPtr;
  61.             request: IOStdReqPtr;
  62.             unitSize: LONGINT;
  63.             access: LONGINT;
  64.             udOffset,
  65.             buf,
  66.             pos,
  67.             udEnd: LONGINT; (* sonst end doppelt bei WITH *)
  68.            END;
  69.     UnitDataPtr = POINTER TO UnitData;
  70.  
  71. (* $R- $S- $V- $F- *)
  72.  
  73. PROCEDURE Cleanup;
  74. BEGIN
  75.   SETREG(0,Wait(LONGSET{})); (* never return!!!!!!!! *)
  76. END Cleanup;
  77.  
  78. PROCEDURE StrICmp(a,b:CharPtr):BOOLEAN;
  79. BEGIN
  80.   WHILE (CAP(a^)=CAP(b^)) AND (a^#0C) DO
  81.     INC(a); INC(b);
  82.   END;
  83.   RETURN (a^=0C) AND (b^=0C)
  84. END StrICmp;
  85.  
  86. PROCEDURE strlen(p:CharPtr):LONGINT;
  87. VAR l:LONGINT;
  88. BEGIN
  89.   l:=0;
  90.   WHILE p^#0C DO INC(p); INC(l) END;
  91.   RETURN l;
  92. END strlen;
  93.  
  94. PROCEDURE StrCpy(to,from:CharPtr);
  95. BEGIN
  96.   DEC(to); DEC(from);
  97.   REPEAT
  98.     INC(to); INC(from);
  99.     to^:=from^;
  100.   UNTIL to^=0C;
  101. END StrCpy;
  102.  
  103. PROCEDURE ReturnPacket(packet:DosPacketPtr; sender:ProcessPtr);
  104. VAR mp: MsgPortPtr;
  105. BEGIN
  106.   WITH packet^ DO
  107.     mp:=port;
  108.     WITH link^.node DO
  109.       name:=packet;
  110.       succ:=NIL;
  111.       pred:=NIL;
  112.     END;
  113.     port:=ADR(sender^.msgPort);
  114.     PutMsg(mp,link);
  115.   END;
  116. END ReturnPacket;
  117.  
  118. PROCEDURE WaitPacket(rec:ProcessPtr):DosPacketPtr;
  119. TYPE WaitProc = PROCEDURE():MessagePtr;
  120. VAR msg: MessagePtr;
  121.     PKTWAIT: WaitProc;
  122. BEGIN
  123. (*  PKTWAIT:=CAST(WaitProc,rec^.pktWait);
  124.   IF CAST(LONGINT,PKTWAIT)#0 THEN
  125.     msg:=PKTWAIT()
  126.   ELSE *)
  127.     WaitPort(ADR(rec^.msgPort));
  128.     msg:=GetMsg(ADR(rec^.msgPort));
  129. (*  END;*)
  130.   RETURN CAST(DosPacketPtr,msg^.node.name)
  131. END WaitPacket;
  132.  
  133. PROCEDURE FindAccessConflict(VAR list:List;name:ADDRESS;mode:LONGINT):BOOLEAN;
  134. VAR node: UnitDataPtr;
  135. BEGIN
  136.   node:=CAST(UnitDataPtr,list.head);
  137.   WHILE CAST(NodePtr,node)#node^.node.succ DO
  138.     IF StrICmp(node^.node.name,name) AND (node^.access=mode) THEN
  139.       RETURN TRUE
  140.     END;
  141.     node:=CAST(UnitDataPtr,node^.node.succ);
  142.   END;
  143.   RETURN FALSE;
  144. END FindAccessConflict;
  145.  
  146. PROCEDURE DoDeviceCmd(unit:UnitDataPtr;cmd:CARDINAL):LONGINT;
  147. BEGIN
  148.   WITH unit^ DO
  149.     WITH request^ DO
  150.       offset:=udOffset;
  151.       data:=buf;
  152.       length:=udEnd;
  153.       command:=cmd;
  154.     END;
  155.     DoIO(request);
  156.   END;
  157.   IF unit^.request^.error#0 THEN
  158.     SETREG(0,DoDeviceCmd(unit,Exec.clear));
  159.     RETURN DOSTRUE
  160.   ELSE
  161.     RETURN unit^.request^.actual
  162.   END;
  163. END DoDeviceCmd;
  164.  
  165. PROCEDURE DoDiskCmd(unit:UnitDataPtr; cmd:CARDINAL; baf:CharPtr;
  166.             length:LONGINT):LONGINT;
  167. VAR i:LONGINT;
  168.     act:CharPtr;
  169. BEGIN
  170.   WITH unit^ DO
  171.     IF length>udEnd-pos THEN
  172.       length:=udEnd-pos
  173.     END;
  174.     IF length>0 THEN
  175.       IF cmd=Exec.read THEN
  176.     IF DoDeviceCmd(unit,Exec.read)=udEnd THEN
  177.       act:=CAST(CharPtr,buf+pos);
  178.       FOR i:=0 TO length-1 DO
  179.         baf^:=act^;
  180.         INC(baf); INC(act);
  181.       END;
  182.       INC(pos,length);
  183.     ELSE
  184.       length:=DOSTRUE;
  185.       act:=CAST(CharPtr,buf);
  186.       FOR i:=0 TO udEnd-1 DO
  187.         act^:=0C; INC(act);
  188.       END;
  189.       pos:=udEnd;
  190.     END;
  191.       ELSIF cmd=Exec.write THEN
  192.     act:=CAST(CharPtr,buf+pos);
  193.     FOR i:=0 TO length-1 DO
  194.       act^:=baf^;
  195.       INC(act); INC(baf);
  196.     END;
  197.     IF (DoDeviceCmd(unit,Exec.write)=DOSTRUE) OR
  198.          (DoDeviceCmd(unit,Exec.update)=DOSTRUE) THEN
  199.       length:=DOSTRUE;
  200.     ELSE
  201.       INC(pos,length);
  202.     END;
  203.       ELSE
  204.         length:=DOSTRUE;
  205.       END;
  206.     END;
  207.   END;
  208.   RETURN length;
  209. END DoDiskCmd;
  210.  
  211. PROCEDURE CloseDiskDevice(unit:UnitDataPtr; arg:INTEGER);
  212. BEGIN
  213.   WITH unit^ DO
  214.     IF arg<=0 THEN
  215.       FreeMem(buf,udEnd);
  216.     END;
  217.     IF arg<=1 THEN
  218.       request^.length:=0;
  219.       request^.command:=Exec.nonstd;
  220.       DoIO(request);
  221.       CloseDevice(request);
  222.     END;
  223.     IF arg<=2 THEN
  224.       DeleteStdIO(request);
  225.     END;
  226.     IF arg<=3 THEN
  227.       DeletePort(port);
  228.     END;
  229.     IF arg<=4 THEN
  230.       FreeMem(unit,unitSize);
  231.     END;
  232.   END;
  233. END CloseDiskDevice;
  234.  
  235. PROCEDURE OpenDiskDevice(devname:CharPtr; dosbase:DosLibraryPtr):UnitDataPtr;
  236. VAR
  237.    cname: ARRAY[0..FNSIZE] OF CHAR;
  238.    dn:DeviceListPtr;
  239.    fssm: FileSysStartupMsgPtr;
  240.    dev: EnvironmentPtr;
  241.    unit: UnitDataPtr;
  242. BEGIN
  243.   dn:=dosbase^.root^.info^.devInfo;
  244.   WHILE dn#NIL DO
  245.   WITH dn^ DO
  246.     IF (type=device) AND (task#NIL) AND (startup#NIL) THEN
  247.       BSTRtoStr(name,cname);
  248.       IF StrICmp(devname,ADR(cname)) THEN
  249.         fssm:=startup;
  250.         unit:=AllocMem(SIZE(UnitData)+strlen(devname)+1,
  251.                 MemReqSet{public,memClear});
  252.         IF unit#NIL THEN
  253.           unit^.node.name:=CAST(ADDRESS,CAST(LONGINT,unit)+SIZE(UnitData));
  254.       StrCpy(unit^.node.name,devname);
  255.       unit^.unitSize:=SIZE(UnitData)+strlen(devname)+1;
  256.       dev:=fssm^.environment;
  257.       unit^.port:=CreatePort(NIL,0);
  258.       IF unit^.port#NIL THEN
  259.         unit^.request:=CreateStdIO(unit^.port);
  260.         IF unit^.request#NIL THEN
  261.           BSTRtoStr(fssm^.device,cname);
  262.           OpenDevice(ADR(cname),fssm^.unit,unit^.request,fssm^.flags);
  263.           IF unit^.request^.error=0 THEN
  264.             WITH dev^ DO
  265.           unit^.udEnd:=arr[sizeBlock]*4*arr[reservedBlocks];
  266.           unit^.buf:=AllocMem(unit^.udEnd,MemReqSet{memClear}+
  267.                       CAST(MemReqSet,arr[memBufType]));
  268.           IF unit^.buf#NIL THEN
  269.             unit^.pos:=0;
  270.             unit^.udOffset:=arr[lowCyl]*arr[blksPerTrack]*
  271.                         arr[numHeads]*arr[sizeBlock]*4;
  272.             RETURN unit;
  273.           ELSE (* no unit^.buf *)
  274.             CloseDiskDevice(unit,1);
  275.           END; (* if unit^.buf#NIL *)
  276.         END; (* with devv^ *)
  277.           ELSE (* err opendevice *)
  278.             CloseDiskDevice(unit,2);
  279.           END; (* if opendevice *)
  280.         ELSE (* no request *)
  281.           CloseDiskDevice(unit,3);
  282.         END; (* if request#nil *)
  283.       ELSE (* no port *)
  284.         CloseDiskDevice(unit,4);
  285.       END; (* if port#nil *)
  286.         ELSE (* no memory *)
  287.           CloseDiskDevice(unit,5);
  288.         END; (* if unit # nil *)
  289.       END; (* if stricmp *)
  290.     END; (* if type=device *)
  291.   END; (* with dn^ *)
  292.   dn:=dn^.next;
  293.   END; (* WHILE dn#nil *)
  294.   RETURN NIL;
  295. END OpenDiskDevice;
  296.  
  297. (*VAR ptype:ARRAY [0..31] OF CHAR;
  298. PROCEDURE MakeMsg(type:LONGINT);
  299. VAR i:INTEGER;
  300. BEGIN
  301.   ptype:='got packet:000000';
  302.   FOR i:=16 TO 11 BY -1 DO
  303.     ptype[i]:=CHAR(type REM 10+30H);
  304.     type:=type/10;
  305.   END;
  306. END MakeMsg;*)
  307.  
  308. (*PROCEDURE MakeVal(type:LONGINT);
  309. VAR i:INTEGER;
  310. BEGIN
  311.   ptype:='value: 000000';
  312.   FOR i:=12 TO 7 BY -1 DO
  313.     ptype[i]:=CHAR(type REM 10+30H);
  314.     type:=type/10;
  315.   END;
  316.   BreakPoint(ADR(ptype));
  317. END MakeVal;
  318. *)
  319.  
  320. PROCEDURE DosHandler;
  321. VAR    actual: LONGINT;
  322.     diskname: CharPtr;
  323.     diskbuf: ARRAY[0..FNSIZE] OF CHAR;
  324.     fh: FileHandlePtr;
  325.     UD: UnitDataPtr;
  326.     AccessList: List;
  327.     DOSBase: DosLibraryPtr;
  328.     proc: ProcessPtr;
  329.     pkt: DosPacketPtr;
  330.     devnode: DeviceListPtr;
  331.     mymsg: MessagePtr;
  332.  
  333.  
  334.   PROCEDURE MakeLock(name:BSTR; mode:LONGINT):FileLockPtr;
  335.   VAR f:FileLockPtr; a:POINTER TO FileLock;
  336.   BEGIN
  337.     a:=AllocMem(SIZE(FileLock),MemReqSet{public,memClear});
  338.     IF a#NIL THEN
  339.       f:=BPTR(a);
  340.       BSTRtoStr(name,diskbuf);
  341.       diskname:=ADR(diskbuf);
  342.       WHILE diskname^#':' DO INC(diskname) END;
  343.       INC(diskname);
  344.       WITH f^ DO
  345.         access:=mode;
  346.         key:=CAST(LONGINT,OpenDiskDevice(diskname,DOSBase));
  347.         task:=CAST(MsgPortPtr,CAST(LONGINT,FindTask(NIL))+SIZE(Task));
  348.         volume:=devnode;
  349.       END;
  350.       IF f^.key#NIL THEN
  351.         RETURN f;
  352.       ELSE
  353.         FreeMem(a,SIZE(FileLock));
  354.         RETURN NIL
  355.       END;
  356.     ELSE
  357.       RETURN NIL
  358.     END;
  359.   END MakeLock;
  360.  
  361. PROCEDURE DeleteLock(l:FileLockPtr):LONGINT;
  362. BEGIN
  363.   IF l#NIL THEN
  364.     CloseDiskDevice(CAST(UnitDataPtr,l^.key),0);
  365.     FreeMem(ADDRESS(l),SIZE(FileLock));
  366.     RETURN DOSTRUE
  367.   ELSE
  368.     RETURN DOSFALSE
  369.   END;
  370. END DeleteLock;
  371.  
  372. TYPE BFileInfoBlockPtr = BPOINTER TO FileInfoBlock;
  373. PROCEDURE Exam(f:FileLockPtr; fib:BFileInfoBlockPtr):LONGINT;
  374. VAR ud:UnitDataPtr;
  375. BEGIN
  376.   IF f#NIL THEN
  377.     ud:=CAST(UnitDataPtr,f^.key);
  378.     WITH fib^ DO
  379.       diskKey:=f^.key;
  380.       dirEntryType:=-3; (* fileHeader *)
  381.       StrCpy(ADR(fileName[1]),ud^.node.name);
  382.       fileName[0]:=' ';
  383.       protection:=ProtectionFlagSet{delete,execute,script,pure};
  384.       entryType:=-3;
  385.       size:=ud^.udEnd;
  386.       numBlocks:=size/512;
  387.       (* date:= *)
  388.       comment:=' This is not really a file!';
  389.     END;
  390.     RETURN DOSTRUE
  391.   ELSE
  392.     RETURN DOSFALSE
  393.   END;
  394. END Exam;
  395.  
  396. BEGIN
  397.   proc:=CAST(ProcessPtr,FindTask(NIL));
  398.   IF wbStarted THEN
  399.     mymsg:=CAST(MessagePtr,startupMsg);
  400.     pkt:=CAST(DosPacketPtr,mymsg^.node.name);
  401.   ELSE
  402.     pkt:=WaitPacket(proc);
  403.   END;
  404.   devnode:=CAST(DeviceListPtr,pkt^.arg3); (* hier err, war *4 devptr=BPTR *)
  405.   devnode^.task:=ADR(proc^.msgPort);
  406.   pkt^.res1:=DOSTRUE;
  407.   ReturnPacket(pkt,proc);
  408.   DOSBase:=ADR(Dos);
  409.   NewList(ADR(AccessList));
  410.   LOOP (* forever!! *)
  411.     pkt:=WaitPacket(proc);
  412.     WITH pkt^ DO
  413.       IF type=locateObject THEN (* lock erzeugen *)
  414.     res1:=CAST(LONGINT,MakeLock(CAST(BSTR,arg2),arg3));
  415.     res2:=objectNotFound; (* falls fehler *)
  416.       ELSIF type=freeLock THEN
  417.     res1:=DeleteLock(CAST(FileLockPtr,arg1));
  418.     res2:=invalidLock;
  419.       ELSIF type=examineObject THEN
  420.         res1:=Exam(CAST(FileLockPtr,arg1),CAST(BPTR,arg2));
  421.         res2:=invalidLock;
  422.       ELSIF (type=newFile) OR (type=oldFile) OR (type=readWrite) THEN
  423.     fh:=CAST(FileHandlePtr,arg1); (* nicht *4, ist BPTR! *)
  424.     fh^.port:=NIL;
  425.     BSTRtoStr(CAST(BSTR,arg3),diskbuf);
  426.     diskname:=ADR(diskbuf);
  427.     WHILE diskname^#':' DO INC(diskname) END;
  428.     INC(diskname);
  429.     IF (type#oldFile) AND
  430.        (FindAccessConflict(AccessList,diskname,exclusiveLock) OR
  431.         FindAccessConflict(AccessList,diskname,sharedLock)) THEN
  432.       res1:=DOSFALSE;
  433.       res2:=objectInUse;
  434.     ELSE
  435.       UD:=OpenDiskDevice(diskname,DOSBase);
  436.       fh^.arg1:=CAST(LONGINT,UD);
  437.       IF UD#NIL THEN
  438.         IF (type#newFile) AND (DoDeviceCmd(UD,Exec.read) # UD^.udEnd) THEN
  439.           res1:=DOSFALSE;
  440.           res2:=objectNotFound;
  441.           CloseDiskDevice(UD,0);
  442.         ELSE
  443.           IF type=readWrite THEN
  444.             UD^.access:=exclusiveLock
  445.           ELSE
  446.             UD^.access:=sharedLock
  447.           END;
  448.           AddTail(ADR(AccessList),ADR(UD^.node));
  449.           res1:=DOSTRUE;
  450.         END;
  451.       ELSE (* fehler beim Öffnen *)
  452.         res1:=DOSFALSE;
  453.         res2:=objectNotFound;
  454.       END;
  455.     END;
  456.       ELSIF type=ACTIONEND THEN
  457.     UD:=CAST(UnitDataPtr,arg1);
  458.     Remove(ADR(UD^.node));
  459.     CloseDiskDevice(UD,0);
  460.     res1:=DOSTRUE;
  461.       ELSIF type=read THEN
  462.     UD:=CAST(UnitDataPtr,arg1);
  463.     actual:=DoDiskCmd(UD,Exec.read,CAST(CharPtr,arg2),arg3);
  464.     res1:=actual;
  465.     IF actual=DOSTRUE THEN
  466.       res2:=deviceNotMounted;
  467.     END;
  468.       ELSIF type=write THEN
  469.     UD:=CAST(UnitDataPtr,arg1);
  470.     IF (UD^.access=sharedLock) AND
  471.         FindAccessConflict(AccessList,UD^.node.name,exclusiveLock) THEN
  472.       res1:=DOSTRUE;
  473.       res2:=objectInUse;
  474.     ELSE
  475.       actual:=DoDiskCmd(UD,Exec.write,CAST(CharPtr,arg2),arg3);
  476.       res1:=actual;
  477.       IF actual=DOSTRUE THEN
  478.         res2:=writeProtected;
  479.       END;
  480.     END;
  481.       ELSIF type=ACTIONSEEK THEN
  482.     UD:=CAST(UnitDataPtr,arg1);
  483.     actual:=UD^.pos;
  484.     CASE arg3 OF
  485.     | current:
  486.         IF ((actual+arg2)>UD^.udEnd) OR ((actual+arg2)<0) THEN
  487.           actual:=DOSTRUE;
  488.         ELSE
  489.           INC(UD^.pos,arg2);
  490.         END;
  491.     | beginning:
  492.         IF (arg2>UD^.udEnd) OR (arg2<0) THEN
  493.           actual:=DOSTRUE;
  494.         ELSE
  495.           UD^.pos:=arg2;
  496.         END;
  497.     | end:
  498.         IF ((UD^.udEnd+arg2)<0) OR (arg2>0) THEN
  499.           actual:=DOSTRUE;
  500.         ELSE
  501.           UD^.pos:=UD^.udEnd+arg2;
  502.         END;
  503.     | ELSE (* keine gurus!!!! *)
  504.       actual:=DOSTRUE;
  505.     END; (* case *)
  506.     res1:=actual;
  507.     IF actual=DOSTRUE THEN
  508.       res2:=seekError;
  509.     END;
  510.       ELSIF (type=currentVolume) OR (type=flush) THEN
  511.     res1:=DOSFALSE;
  512.     res2:=0;
  513.       ELSIF type=deleteObject THEN
  514.     res1:=DOSFALSE;
  515.     res2:=deleteProtected;
  516.       ELSE (* kennen wir nicht *)
  517.     res1:=DOSFALSE;
  518.     res2:=actionNotKnown;
  519.       END;
  520.     END; (* with pkt^ *)
  521.     ReturnPacket(pkt,proc);
  522.   END; (* endless loop *)
  523. END DosHandler;
  524.  
  525. BEGIN
  526.   TermProcedure(Cleanup);
  527.   DosHandler;
  528. END BootHandler.
  529.